Attribute VB_Name = "basMain"
Public strType As String
Public strBranchCode As String

' FTP stuff
Public hOpen As Long
Public hConnection As Long

' XML stuff
Private Const XML_PATH As Integer = 2
Public blnXMLorNormal As Boolean

'*---------------------------------------------------------------
'*
'* ModuleName:     basPGMain
'* FileName:       PGMAIN.BAS
'* Date:           July 1998
'* Author:         Ian M. Weatherburn
'* Company:        Mindkey Software Solutions (Pty) Ltd.
'* Copyright:      Copyright (C) 1998 by Mindkey Software Solutions
'*                 All Rights Reserved
'* Description:    PGUpload Module Entry Point
'*---------------------------------------------------------------

Option Explicit

'*---------------------------------------------------------------
'* Subroutine:     Main
'* Input:          Command-Line
'* Description:    The MAIN subroutine is called from another
'*                 application with potentially the following
'*                 command-line parameters:
'*                 1.  Branch Name (4 Digit Code)
'*                 2.  File Path and Mask
'*
'*                 If parameters are received and are valid then
'*                 the application should proceeed immediately
'*                 with compressing and transferring the files
'*                 over to the requested server.
'*
'*                 If there are no command-line parameters then
'*                 input dialogs, should capture a request from
'*                 the user in respective of which files he
'*                 wishes to transfer and where he wishes them
'*                 to be transferred.
'*---------------------------------------------------------------
Sub Main()
  Dim blnOk As Boolean
  Dim strBranchCode As String
  Dim strFileMask As String
  Dim strFullPathName As String
  Dim blnValidRASEntry As Boolean
  Dim strPhoneEntry As String
  Dim strShareName As String
  Dim strUserName As String
  Dim strPassword As String
  Dim strCompress As String
  Dim strTransfer As String
  Dim strTransferFile As String
  Dim strNetworkDrive As String
  Dim strSourcePath As String
  Dim strReg As clsOptions
  Dim XML As clsXML
  Dim cmdLine As clsCommandLine
  Dim strError As String
  Dim strXMLFile As String
  
  Set cmdLine = New clsCommandLine
  Set XML = New clsXML
  ' Error handler
  On Error GoTo PG_ERROR
  
  ' Show Splash screen
  
  Set strReg = New clsOptions
       
'  Load frmSplash
'  frmSplash.Show vbModeless
'  'SetWindowPos frmSplash.hWnd, HWND_TOPMOST, 10, 10, 10, 10, SWP_NOMOVE Or SWP_NOSIZE
'  frmSplash.lblEvent.Caption = "Initialising..."
'  frmSplash.Refresh
  
  LogEvent vbCrLf & _
           "*----------------------------------------" & _
           vbCrLf & _
           "* Event Logging: " & Format(Now, "hh:nn:ss dd/mm/yyyy") & _
           vbCrLf & _
           "*----------------------------------------"
  
  ' Does the command-line have a branch and file speicification?
'  frmSplash.lblEvent.Caption = "Checking Application Parameters..."
'  frmSplash.Refresh
  If IsCommandLineValid(Command$) Then
    LogEvent "Valid command line parameters received"
    If blnXMLorNormal = True Then 'XML param  recieved
        strXMLFile = objCommandLine.Item(1)
    Else
        strBranchCode = objCommandLine.Item(1)
        strFileMask = objCommandLine.Item(2)
    End If
  Else
    'load the reg screen
    Load frmRegistry
    frmRegistry.Show
  End If
  
  If blnXMLorNormal = True Then 'XML params recieved
    'read in the XML file

    blnOk = XML.ReadXMLFile(strXMLFile, strError)
    strBranchCode = Right$(XML.FreeText, (Len(XML.FreeText) - InStrRev(XML.FreeText, " ")))
    strFileMask = Right$(XML.ImagePath & "\*.*", (Len(XML.ImagePath & "\*.*") - InStrRev(XML.ImagePath & "\*.*", " ")))
  End If
  
  If strError <> "" Then
    'an error occured whilst reading in the XML file (most likly the cmdline param is incorrect
    MsgBox strError, vbOKOnly + vbExclamation
    Exit Sub
  End If
  
  ' Are the registry entries complete?
RegSettingsCheck:
  If strReg.BranchCode = "" Then
    SetWindowPos frmRegistry.hWnd, HWND_TOPMOST, 10, 10, 10, 10, SWP_NOMOVE Or SWP_NOSIZE
    frmRegistry.Show vbModal
   GoTo RegSettingsCheck
    'Err.Raise 1
  End If
  
  ' Does the branch entry exist in the registry?
'  frmSplash.lblEvent.Caption = "Verifying Remote Branch Name..."
'  frmSplash.Refresh
  If IsBranchNameValid(strBranchCode, _
                       strPhoneEntry, _
                       strShareName, _
                       strUserName, _
                       strPassword, _
                       strCompress, _
                       strTransfer) Then
    LogEvent "Valid Branch Name: " & strBranchCode
    LogEvent "Share Name: " & strShareName
    LogEvent "PhoneEntry: " & strPhoneEntry
    LogEvent "Compression Required: " & strCompress
    LogEvent "Transfer Type: " & strTransfer
  End If
  
  ' Does the branch equate to a valid RAS Phone Entry?
  blnValidRASEntry = IsBranchValidPhoneEntry(strPhoneEntry)
  If blnValidRASEntry Then
    LogEvent "PhoneEntry exists in RAS phonebook"
  Else
    LogEvent "PhoneEntry does not exist. Continuing without dial-up."
  End If
  
  ' Does the specified filepath and mask exist?
'  frmSplash.lblEvent.Caption = "Validating Upload Files..."
'  frmSplash.Refresh
  
  If IsPathValid(strFileMask, strFullPathName) Then
    LogEvent strFullPathName & " is valid"
    ' Populate the collection with all the specified files
    strSourcePath = GetFilesFromPath(strFullPathName)
    If strCompress = "Yes" Then
'        frmSplash.lblEvent.Caption = "Compressing Upload Files..."
'        frmSplash.Refresh
        strTransferFile = CreateCABFile
    Else
        strTransferFile = strFullPathName
    End If
  End If
  
  ' Connect to RAS Server
'  frmSplash.lblEvent.Caption = "Connecting to " & strPhoneEntry & "..."
'  frmSplash.Refresh
  If blnValidRASEntry Then
    If ConnectToServer(strPhoneEntry) Then
      LogEvent "Connected to " & strPhoneEntry
    Else
      LogEvent "Unable to connect to " & strPhoneEntry
      Err.Raise vbObjectError + 1010, "PGUpload.RAS", "Unable to connect to " & strPhoneEntry
    End If
  End If
  
'  frmSplash.aniFindComputer.Open App.Path & "\FindComp.avi"
'  frmSplash.aniFindComputer.Play
'  frmSplash.Refresh

  ' Copy Compressed file to it's destination
'  frmSplash.lblEvent.Caption = "Transferring files... "
'  frmSplash.Refresh
  
  If strTransfer = "Copy" Then
    If Not CopyFileToServer(strTransferFile, strShareName) Then
      Err.Raise vbObjectError + 999, "Copy", "Unable to copy file"
    End If
  End If
  
  If strTransfer = "FTP" Then
    Dim ErrMsg As String
    If Right(strSourcePath, 1) <> "\" Then
        strSourcePath = strSourcePath & "\"
    End If
    If Not FTPFileToServer(strUserName, strPassword, strShareName, strTransferFile, strSourcePath) Then
        ErrMsg = "FTP process to SARS failed:-" & vbCrLf & Chr(13) & vbCrLf & Chr(13)
        ErrMsg = ErrMsg & "Error Description:" & Error & vbCrLf
        ErrMsg = ErrMsg & "Error Number:" & Err & vbCrLf
        ErrMsg = ErrMsg & "FTP ERROR:  FTPFileToServer function failed"
        
        SendEmail "Mindkey", strReg.FTPEmail, ErrMsg, "Keytax FTP error"
    
        LogEvent "FTP process to SARS failed: " & strTransferFile
        Err.Raise vbObjectError + 999, "FTP", "Unable to FTP file"
    Else
          LogEvent "Files successfully sent to SARS"
        '  frmSplash.lblEvent.Caption = "Closing down..."
        '  frmSplash.aniFindComputer.Stop
        '  frmSplash.Refresh
            
          ' File transferred, so delete the source
          If strCompress = "Yes" Then
            If DeleteCABFile(strTransferFile) Then
              LogEvent "CAB file successfully deleted"
            End If
          End If
          
          
          'If DeleteUploadFiles(strSourcePath) Then
          '    LogEvent "Upload Files successfully deleted"
          'End If
          
          
          If DeleteTempFiles(GetTempDir()) Then
            LogEvent "Temporary Files successfully deleted"
          End If
    End If
  End If
  
  
DISCONNECT:
  If blnValidRASEntry Then
    'DisconnectFromServer
    LogEvent "Disconnect From Server"
  End If
  
FINALISE:
  ' Remove Splash screen
'  Unload frmSplash
'  Set frmSplash = Nothing
  
  Exit Sub
  
PG_ERROR:
  LogEvent Err.Description
  Resume FINALISE
  Exit Sub
  Resume Next
End Sub

'*---------------------------------------------------------------
'* Function:    IsPathValid
'* Inputs:      strCommandLine - Command-Line passed to program
'* Outputs:     strFilePath - Drive, Folder-Name, and File-Mask
'* Returns:     Boolean - Was there any command-line, and if
'*                        so did it contain valid information
'* Description: Parse the command-line for a specified directory
'*              and file-mask to obtain filenames from.
'*              If a command-line was specified check to see that
'*              the directory exists, and there is at least one
'*              file that matches the mask
'*---------------------------------------------------------------
Public Function IsPathValid(ByVal strFileMask As String, _
                            ByRef strFilePath As String) As Boolean

  Dim strDrive As String
  Dim strPath As String
  Dim strFileName As String

  ' Get the specified file mask into it's components
  SplitPath strFileMask, strDrive, strPath, strFileName
    
  ' Does the path and/or files exist
  If Dir(strDrive & strPath & strFileName) = "" Then
    IsPathValid = False
    LogEvent "No files found"
    Err.Raise vbObjectError + 1000, _
              "PGUpload Error", _
              "Invalid path and file mask. No files found." & vbCrLf & _
              strFileMask
  Else
    IsPathValid = True
    strFilePath = strDrive & strPath & strFileName
  End If

End Function
'*---------------------------------------------------------------
'* Subroutine:     GetFilesFromPath
'* Input:          Folder and File-Mask specification
'* Description:    Given a drive, folder-name and file-mask
'*                 specification (potentially), process all
'*                 files in the directory and add them to a
'*                 file collection as fully-qualified filenames
'*---------------------------------------------------------------
Function GetFilesFromPath(strPath As String) As String
  Dim strFileName As String
  Dim strCurrentDrive As String
  Dim strCurrentPath As String
  Dim strCurrentFile As String
  
  ' Create File list collection
  Set objFileList = New clsFileList
  objFileList.Clear
  
  SplitPath strPath, strCurrentDrive, strCurrentPath, strCurrentFile
  
  strFileName = Dir(strPath, vbNormal Or vbHidden)
  Do While strFileName <> ""
    objFileList.AddEntry strCurrentDrive & strCurrentPath & strFileName
    strFileName = Dir
  Loop
  
  GetFilesFromPath = strCurrentDrive & Left(strCurrentPath, Len(strCurrentPath) - 1)
  
End Function

'*---------------------------------------------------------------
'* Function:       IsCommandLineValid
'*---------------------------------------------------------------
Private Function IsCommandLineValid(ByVal strCommandLine As String) As Boolean
  Dim strFolderExists As String
  Set objCommandLine = New clsCommandLine
     
  objCommandLine.Parse strCommandLine
  
  'there are now 3 cmd line params;
  '1) the Destination code
  '2) the path of the XML file
  If basMain.blnXMLorNormal = True Then
    If objCommandLine.Count = 1 Then
        IsCommandLineValid = True
    Else
        IsCommandLineValid = False
    End If
  Else
     If objCommandLine.Count = 2 Then
        IsCommandLineValid = True
     Else
        IsCommandLineValid = False
     End If
  End If
  
End Function

'*---------------------------------------------------------------
'* Function:       IsBranchNameValid
'*---------------------------------------------------------------
Private Function IsBranchNameValid(ByVal strBranchCode As String, _
                                   ByRef strPhoneEntry As String, _
                                   ByRef strShareName As String, _
                                   ByRef strUserName As String, _
                                   ByRef strPassword As String, _
                                   ByRef strCompress As String, _
                                   ByRef strTransfer As String) As Boolean
    
  Dim strRegKey As String
  Dim strValue As String
  Dim objOptions As New clsOptions
    
  On Error GoTo REG_ERROR
  
  ' Get the RAS Phone Entry name
  strPhoneEntry = objOptions.PhoneEntry(strBranchCode)
  
  ' Get the share name to map to
  strShareName = objOptions.ShareName(strBranchCode)
  If strShareName = "" Then
    'Err.Raise 1
  End If
  
  ' Get the user name to login with
  strUserName = objOptions.UserName(strBranchCode)
  
  ' Get the password to login with
  strPassword = objOptions.Password(strBranchCode)
  
  ' Should we compress the batch
  strCompress = objOptions.Compress(strBranchCode)
  
  ' How should we transfer files
  strTransfer = objOptions.Transfer(strBranchCode)
  
  ' The key existed so the branch is valid
  IsBranchNameValid = True
  
  Exit Function
  
REG_ERROR:
  ' The key didn't exist, so the branch is invalid
  IsBranchNameValid = False
  
  Err.Raise vbObjectError + 1001, _
            "PGUpload Error", _
            "Specified Branch does not exist" & vbCrLf & _
            "Branch Name: " & strBranchCode
  
End Function

'*---------------------------------------------------------------
'* Function:       IsBranchValidPhoneEntry
'*---------------------------------------------------------------
Private Function IsBranchValidPhoneEntry(ByVal strBranchCode As String) As Boolean

  Dim intEntries, intEntryCount As Integer
  Dim blnValidBranch As Boolean
  
  On Error GoTo RASENGINE_ERROR

  blnValidBranch = False
  Set objRASEngine = New clsRASEngine
  intEntryCount = objRASEngine.PhoneEntries.Count
  
  For intEntries = 0 To intEntryCount - 1
    If objRASEngine.PhoneEntries(intEntries).EntryName = _
       strBranchCode Then
      blnValidBranch = True
      Exit For
    End If
  Next intEntries
  
  IsBranchValidPhoneEntry = blnValidBranch
  
  Exit Function
  
RASENGINE_ERROR:
  LogEvent Err.Description
  IsBranchValidPhoneEntry = False
End Function

'*---------------------------------------------------------------
'* Subroutine:    CompressFiles
'*---------------------------------------------------------------
Private Function CreateCABFile() As String

  Set objBranches = New clsBranches
  Set objCABFile = New clsCompress
  
  ' Compress data files ready for upload
  Load frmCABCompress
  SetWindowPos frmCABCompress.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
  frmCABCompress.Show vbModal
  Unload frmCABCompress
  Set frmCABCompress = Nothing
  
  CreateCABFile = objCABFile.CabFileName
End Function

'*---------------------------------------------------------------
'* Subroutine:    CopyFileToServer
'*---------------------------------------------------------------
Private Function CopyFileToServer(ByVal strSource As String, _
                                  ByVal strDest As String) As Boolean
  Dim lngSourceLength As Long
  Dim lngDestLength As Long
  Dim strDrive As String
  Dim strPath As String
  Dim strFileName As String
  
  On Error GoTo PROC_ERROR

  Load frmCABCopy
  SetWindowPos frmCABCopy.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
  frmCABCopy.Show vbModeless
  
  SplitPath strSource, strDrive, strPath, strFileName
  strFileName = Dir(strSource)
  Do While strFileName <> ""
      
      frmCABCopy.lblSourceFile.Caption = strDrive & strPath & strFileName
      frmCABCopy.lblDestFile.Caption = strDest & "\" & strFileName
      frmCABCopy.Refresh
      DoEvents
    
      ' Kill destination if exists
      On Error Resume Next
      SetAttr strDest & "\" & strFileName, vbNormal
      Kill strDest & "\" & strFileName
      On Error GoTo PROC_ERROR
      
      ' Actually copy the file
      FileCopy strDrive & strPath & strFileName, strDest & "\" & strFileName
      DoEvents
      
      If FileLen(strDrive & strPath & strFileName) = FileLen(strDest & "\" & strFileName) Then
        SetAttr strDest & "\" & strFileName, vbReadOnly
        CopyFileToServer = True
      Else
        CopyFileToServer = False
        Err.Raise vbObjectError + 1005, _
                  "PGUpload Error", _
                  "Files not successfully copied: " & vbCrLf & _
                  "Source Files: " & strDrive & strPath & strFileName & vbCrLf & _
                  "Destination Files: " & strDest & "\" & strFileName
                  
      End If
      strFileName = Dir
  Loop
  
PROC_EXIT:
  Unload frmCABCopy
  Set frmCABCopy = Nothing
  
  Exit Function
  
PROC_ERROR:
  Unload frmCABCopy
  Set frmCABCopy = Nothing
  CopyFileToServer = False
  Err.Clear
  Err.Raise vbObjectError + 1005, _
            "PGUpload Error", _
            "Files not successfully copied: " & vbCrLf & _
            "Source Files: " & strSource & vbCrLf & _
            "Destination Files: " & strFileName
  Resume PROC_EXIT
  
End Function

'*---------------------------------------------------------------
'* Subroutine:    FTPFileToServer
'*---------------------------------------------------------------
Private Function FTPFileToServer(ByVal strUserName As String, _
                                 ByVal strPassword As String, _
                                 ByVal strDir As String, _
                                 ByVal strSource As String, Optional strSourceFilesPath As String) As Boolean

    Dim strDrive As String
    Dim strPath As String
    Dim strFileName As String
    Dim SARSFiles As String
    Dim ErrMsg As String
    Dim arrFiles() As String
    Dim FilesFTP As String
    Dim i As Long
    Dim strReg As clsOptions
    
    FTPFileToServer = False
    
    On Error GoTo PROC_ERROR
    
    Set strReg = New clsOptions
    
    LogEvent "Starting to FTP Files"
    
    hOpen = InternetOpen("KeyTax", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If hOpen = 0 Then
        ErrorOut Err.LastDllError, "InternetOpen"
        Exit Function
    End If
    
    If hConnection <> 0 Then
        InternetCloseHandle hConnection
    End If
    
    hConnection = InternetConnect(hOpen, "localhost", INTERNET_INVALID_PORT_NUMBER, strUserName, strPassword, INTERNET_SERVICE_FTP, 0, 0) ' Second last indicates Active or Passive??
    If hConnection = 0 Then
        ErrMsg = "FTP process to SARS failed:-" & vbCrLf & Chr(13) & vbCrLf & Chr(13)
        ErrMsg = ErrMsg & "Error Description:" & Error & vbCrLf
        ErrMsg = ErrMsg & "Error Number:" & Err & vbCrLf
        ErrMsg = ErrMsg & "FTP ERROR:  Connection to SARS cannot be initiated"
        SendEmail "Mindkey", strReg.FTPEmail, ErrMsg, "Keytax FTP error"
    
        ErrorOut Err.LastDllError, "InternetConnect"
        Exit Function
    Else
        
        ' Change Dir
        If (FtpSetCurrentDirectory(hConnection, strDir) = False) Then
            ErrMsg = "FTP process to SARS failed:-" & vbCrLf & Chr(13) & vbCrLf & Chr(13)
            ErrMsg = ErrMsg & "Error Description:" & Error & vbCrLf
            ErrMsg = ErrMsg & "Error Number:" & Err & vbCrLf
            ErrMsg = ErrMsg & "FTP ERROR:  FTP Directory cannot be set"
            SendEmail "Mindkey", strReg.FTPEmail, ErrMsg, "Keytax FTP error"
            ErrorOut Err.LastDllError, "FtpSetCurrentDirectory"
            Exit Function
        End If
        
        Load frmCABCopy
        SetWindowPos frmCABCopy.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
        frmCABCopy.Show vbModeless
        
        SplitPath strSource, strDrive, strPath, strFileName
        strFileName = Dir(strSource, vbNormal)
        
        FilesFTP = ""
        While strFileName <> ""
            FilesFTP = strFileName & "," & FilesFTP
            strFileName = Dir
        Wend
        
        FilesFTP = Left(FilesFTP, Len(FilesFTP) - 1)
        arrFiles = Split(FilesFTP, ",")
        'While strFileName <> ""
        For i = LBound(arrFiles) To UBound(arrFiles)
            strFileName = arrFiles(i)
            'frmCABCopy.lblSourceFile.Caption = strDrive & strPath & strFileName
            frmCABCopy.lblSourceFile.Caption = strDrive & strPath & arrFiles(i)
            
            frmCABCopy.lblDestFile.Caption = strDir & "/" & strFileName
            frmCABCopy.Refresh
            DoEvents
            
            ' Put a file
            If (FtpPutFile(hConnection, strDrive & strPath & strFileName, strFileName, FTP_TRANSFER_TYPE_BINARY, 0) = False) Then
                ErrMsg = "FTP process to SARS failed:-" & vbCrLf & Chr(13) & vbCrLf & Chr(13)
                ErrMsg = ErrMsg & "Error Description:" & Error & vbCrLf
                ErrMsg = ErrMsg & "Error Number:" & Err & vbCrLf
                ErrMsg = ErrMsg & "FTP FILENAME:" & strFileName & " failed to be FTP to SARS"
                
                SendEmail "Mindkey", strReg.FTPEmail, ErrMsg, "Keytax FTP error"
                ErrorOut Err.LastDllError, "FtpPutFile"
                Exit Function
            End If
    
            ' Rename file
            If (FtpRenameFile(hConnection, strFileName, Left(strFileName, InStr(strFileName, ".")) & "R" & Right(strFileName, Len(strFileName) - (InStr(strFileName, ".") + 1))) = False) Then
                ErrMsg = "FTP process to SARS failed:-" & vbCrLf & Chr(13) & vbCrLf & Chr(13)
                ErrMsg = ErrMsg & "Error Description:" & Error & vbCrLf
                ErrMsg = ErrMsg & "Error Number:" & Err & vbCrLf
                ErrMsg = ErrMsg & "FTP FILENAME:" & strFileName & " failed to be FTP to SARS"
                
                SendEmail "Mindkey", strReg.FTPEmail, ErrMsg, "Keytax FTP error"
                ErrorOut Err.LastDllError, "FtpRenameFile"
                Exit Function
            End If
            
            If MoveCurrentFile(strSourceFilesPath, strFileName) Then
                'Audit Extract Files
                LogEvent strFileName & " successfully sent to SARS"
                SARSFiles = strFileName & vbCrLf & SARSFiles
            Else
                FTPFileToServer = False
                LogEvent "Failed to move file: " & strFileName & " to SENT folder"
                Exit Function
            End If
            
            'Here move the to "SENT" folder because if this function fails all files
            
            'strFileName = Dir
        Next i
        
        ' Disconnect
        If hConnection <> 0 Then
            InternetCloseHandle hConnection
        End If
        hConnection = 0
    
        FTPFileToServer = True
        
        'Log a successfull FTP process
        LogEvent "All Files Successfully sent SARS"
        
        Dim EmailMsg As String
        
        EmailMsg = "Process Date: " & Date & " " & Now & vbCrLf & Chr(13)
        EmailMsg = EmailMsg & "Files sent to SARS:" & vbCrLf & SARSFiles
        
        SendEmail "Mindkey", strReg.FTPEmail, EmailMsg, "Keytax FTP"
    End If
  
PROC_EXIT:
  Unload frmCABCopy
  Set frmCABCopy = Nothing
  Set strReg = Nothing
  Exit Function
  
PROC_ERROR:
  SendEmail "Mindkey", strReg.FTPEmail, "FTP Error occured:" & vbCrLf & Chr(13) & "Error Description: " & Error & Chr(13) & "Error Number: " & Err, "Keytax FTP Error"
  Unload frmCABCopy
  Set strReg = Nothing
  Set frmCABCopy = Nothing
  FTPFileToServer = False
  Err.Clear
  Err.Raise vbObjectError + 1005, _
            "PGUpload Error", _
            "Files not successfully FTP'd: " & vbCrLf & _
            "Source Files: " & strSource & vbCrLf & _
            "Destination Files: " & strFileName
  Resume PROC_EXIT
  
End Function

'*---------------------------------------------------------------
'* Subroutine:    DeleteCABFile
'*---------------------------------------------------------------
Private Function DeleteCABFile(strFile As String) As Boolean
  On Error GoTo ERROR_KILL
  
  ' Delete the .CAB file first
  Kill strFile
    
  DeleteCABFile = True
  
  Exit Function
  
ERROR_KILL:
  DeleteCABFile = False
  Err.Raise vbObjectError + 1006, _
            "PGUpload Error", _
            "Unable to delete CAB file" & vbCrLf & _
            "File: " & strFile
End Function

'*---------------------------------------------------------------
'* Subroutine:    DeleteUploadFiles
'*---------------------------------------------------------------
Private Function DeleteUploadFiles(ByVal strSourcePath As String) As Boolean
  Dim intFileCount As Integer
  Dim blnMoveFiles As Boolean
  Dim strDeleteFiles As String
  Dim strDrive As String
  Dim strPath As String
  Dim strFileName As String
  Dim blnDeleteFile As Boolean
  Dim strMoveFolder As String
  Dim objOptions As New clsOptions

  On Error GoTo ERROR_KILL
  
  'Should we delete the files or move them?
  strDeleteFiles = objOptions.DeleteFiles
  LogEvent "DeleteFiles: '" & strDeleteFiles & "'"
                              
  If UCase(strDeleteFiles) <> "YES" Then
    blnMoveFiles = True
    strMoveFolder = objOptions.MoveFolder
    LogEvent "MoveFolder: '" & strMoveFolder & "'"
    
    If Trim(strMoveFolder) = "" Or strMoveFolder = " " Then
      strMoveFolder = strSourcePath & "\backup"
    End If
    LogEvent "Original files to be moved to " & strMoveFolder
                             
    ' Create the directory if it doesn't exist
    If Dir(strMoveFolder, vbDirectory) = "" Then
      LogEvent strMoveFolder & " does not exist. Creating directory."
      CreateLongDir (strMoveFolder & "\")
    End If
  Else
    LogEvent "Original files being deleted, not moved!"
    blnMoveFiles = False
  End If
  
  
  ' Delete original files
  For intFileCount = 1 To objFileList.Count
    ' Move the file to another directory if needed
    If blnMoveFiles Then
      SplitPath objFileList.Item(intFileCount), strDrive, strPath, strFileName
      FileCopy objFileList.Item(intFileCount), strMoveFolder & "\" & strFileName
    
      If FileLen(objFileList.Item(intFileCount)) = FileLen(strMoveFolder & "\" & strFileName) Then
        blnDeleteFile = True
      Else
        LogEvent "Unable to move source file to destination" & vbCrLf & _
                 "Source File: " & objFileList.Item(intFileCount) & vbCrLf & _
                 "Dest File: " & strMoveFolder & "\" & strFileName
        blnDeleteFile = False
      End If
    Else
      blnDeleteFile = True
    End If
    
    ' Delete the original file
    If blnDeleteFile Then
        SetAttr objFileList.Item(intFileCount), vbNormal
        Kill objFileList.Item(intFileCount)
    End If
  Next intFileCount
  
  DeleteUploadFiles = True
  
  Exit Function
  
ERROR_KILL:
  DeleteUploadFiles = False
  Err.Raise vbObjectError + 1006, _
            "PGUpload Error", _
            "Unable to delete Upload File" & vbCrLf & _
            "File: " & objFileList.Item(intFileCount)
End Function

'*---------------------------------------------------------------
'* Subroutine:    DeleteTempFiles
'*---------------------------------------------------------------
Private Function DeleteTempFiles(strFile As String) As Boolean
  On Error GoTo ERROR_KILL
  
  ' Delete the temp files
  Kill strFile & "xx*.*"
    
  DeleteTempFiles = True
  
  Exit Function
  
ERROR_KILL:
  DeleteTempFiles = False
  Err.Raise vbObjectError + 1006, _
            "PGUpload Error", _
            "Unable to delete temporary files" & vbCrLf & _
            "File: " & strFile & "xx*.*"
End Function

Public Function SendEmail(RecipientName As String, RecipientEmail As String, FaxBody As String, EmailSubject As String) As Boolean
    
    Dim sSQL As String
    Dim lRecordsAffected As Long
    Dim i, j
    Dim sString, sHiddenColumns
    Dim blResult As Boolean
    Dim blLocalConnect As Boolean
    Dim sAttachments() As String
    Dim sAttachmentFiles() As String
    Dim lAttachmentFileCount As Long
    Dim lAttachmentCount As Long
    Dim sAttachmentFileName As String
    Dim sEmailView As String
    Dim sSendCaseStatus As String
    Dim sFromName As String
    Dim sReplyEmail As String
    Dim sHTMLBody As String
    Dim arMailTo() As String
    Dim iCounter As Long
    
    Dim oMail As Object
    
    'On Error GoTo ErrHandler:
    On Error Resume Next
    Set oMail = CreateObject("jmail.Message")
    
    oMail.Logging = True
    sReplyEmail = "Info@Mindkey.co.za"
    
    'ReDim arMailTo(0)
    arMailTo() = Split(RecipientEmail, ";")
        
    With oMail
        For iCounter = 0 To UBound(arMailTo)
            .AddRecipient CStr(arMailTo(iCounter))
        Next iCounter
            
        sFromName = "KEYTAX SARS FTP"
                        
        .ISOEncodeHeaders = False
        .From = sReplyEmail
        .Subject = EmailSubject
        .FromName = sFromName
        .Body = FaxBody
        .send ("trend1.liberty.co.za")
    End With
        
    If Err.Number = 0 Then
        SendEmail = True
    Else
        SendEmail = False
    End If
    Set oMail = Nothing
    Exit Function
ErrHandler:
    Set oMail = Nothing
    SendEmail = False
    Exit Function
    Resume Next
End Function

'*---------------------------------------------------------------
'* Subroutine:    DeleteUploadFiles
'*---------------------------------------------------------------
Private Function MoveCurrentFile(ByVal strSourcePath As String, ByVal strCurrFile As String) As Boolean
  Dim intFileCount As Integer
  Dim blnMoveFiles As Boolean
  Dim strDeleteFiles As String
  Dim strDrive As String
  Dim strPath As String
  Dim strFileName As String
  Dim blnDeleteFile As Boolean
  Dim strMoveFolder As String
  Dim objOptions As New clsOptions

  On Error GoTo ERROR_KILL
  
  'Should we delete the files or move them?
  strDeleteFiles = objOptions.DeleteFiles
  LogEvent "DeleteFiles: '" & strDeleteFiles & "'"
                              
  If UCase(strDeleteFiles) <> "YES" Then
    blnMoveFiles = True
    strMoveFolder = objOptions.MoveFolder
    LogEvent "MoveFolder: '" & strMoveFolder & "'"
    
    If Trim(strMoveFolder) = "" Or strMoveFolder = " " Then
      strMoveFolder = strSourcePath & "\backup"
    End If
    LogEvent "Original files to be moved to " & strMoveFolder
                             
    ' Create the directory if it doesn't exist
    If Dir(strMoveFolder, vbDirectory) = "" Then
      LogEvent strMoveFolder & " does not exist. Creating directory."
      CreateLongDir (strMoveFolder & "\")
    End If
  Else
    LogEvent "Original files being deleted, not moved!"
    blnMoveFiles = False
  End If
  
  
  ' Delete original files
  'For intFileCount = 1 To objFileList.Count
    ' Move the file to another directory if needed
    If blnMoveFiles Then
      'SplitPath objFileList.Item(intFileCount), strDrive, strPath, strFileName
      FileCopy strSourcePath & strCurrFile, strMoveFolder & "\" & strCurrFile
    
      If FileLen(strSourcePath & strCurrFile) = FileLen(strMoveFolder & "\" & strCurrFile) Then
        blnDeleteFile = True
      Else
        LogEvent "Unable to move source file to destination" & vbCrLf & _
                 "Source File: " & strCurrFile & vbCrLf & _
                 "Dest File: " & strMoveFolder & "\" & strCurrFile
        blnDeleteFile = False
      End If
    Else
      blnDeleteFile = True
    End If
    
    ' Delete the original file
    If blnDeleteFile Then
        SetAttr strSourcePath & strCurrFile, vbNormal
        Kill strSourcePath & strCurrFile
    End If
  'Next intFileCount
  
  MoveCurrentFile = True
  
  Exit Function
  
ERROR_KILL:
  MoveCurrentFile = False
  Err.Raise vbObjectError + 1006, _
            "PGUpload Error", _
            "Unable to move FTP File" & vbCrLf & _
            "File: " & strSourcePath & strCurrFile
End Function

